home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / sbin / install-info < prev    next >
Text File  |  2008-09-03  |  16KB  |  523 lines
  1. #!/usr/bin/perl --
  2.  
  3. BEGIN { # Work-around for bug #479711 in perl
  4.     $ENV{PERL_DL_NONLAZY} = 1;
  5. }
  6.  
  7. use Text::Wrap;
  8. use Dpkg;
  9. use Dpkg::Gettext;
  10.  
  11. textdomain("dpkg");
  12.  
  13. # fixme: sort entries
  14. # fixme: send to FSF ?
  15.  
  16. sub version {
  17.     printf _g("Debian %s version %s.\n"), $progname, $version;
  18.  
  19.     printf _g("
  20. Copyright (C) 1994,1995 Ian Jackson.");
  21.  
  22.     printf _g("
  23. This is free software; see the GNU General Public Licence version 2 or
  24. later for copying conditions. There is NO warranty.
  25. ");
  26. }
  27.  
  28. sub usage {
  29.     $file = $_[0];
  30.     printf $file _g(
  31. "Usage: %s [<options> ...] [--] <filename>
  32.  
  33. Options:
  34.   --section <regexp> <title>
  35.                            put the new entry in the <regex> matched section
  36.                            or create a new one with <title> if non-existent.
  37.   --menuentry=<text>       set the menu entry.
  38.   --description=<text>     set the description to be used in the menu entry.
  39.   --info-file=<path>       specify info file to install in the directory.
  40.   --dir-file=<path>        specify file name of info directory file.
  41.   --infodir=<directory>    same as '--dir-file=<directory>/dir'.
  42.   --info-dir=<directory>   likewise.
  43.   --keep-old               do not replace entries nor remove empty ones.
  44.   --remove                 remove the entry specified by <filename> basename.
  45.   --remove-exactly         remove the exact <filename> entry.
  46.   --test                   enables test mode (no actions taken).
  47.   --debug                  enables debug mode (show more information).
  48.   --quiet                  do not show output messages.
  49.   --help                   show this help message.
  50.   --version                show the version.
  51. "), $progname;
  52. }
  53.  
  54. $dirfile = '/usr/share/info/dir';
  55. $maxwidth=79;
  56. $Text::Wrap::columns=$maxwidth;
  57. $backup='/var/backups/infodir.bak';
  58. $default='/usr/share/base-files/info.dir';
  59.  
  60. $menuentry="";
  61. $description="";
  62. $sectionre="";
  63. $sectiontitle="";
  64. $infoentry="";
  65. $quiet=0;
  66. $nowrite=0;
  67. $keepold=0;
  68. $debug=0;
  69. $remove=0;
  70.  
  71. my $remove_exactly;
  72.  
  73. $0 =~ m|[^/]+$|; $name= $&;
  74.  
  75. while ($ARGV[0] =~ m/^--/) {
  76.     $_= shift(@ARGV);
  77.     last if $_ eq '--';
  78.     if ($_ eq '--version') {
  79.         &version(STDOUT); exit 0;
  80.     } elsif ($_ eq '--quiet') {
  81.         $quiet=1;
  82.     } elsif ($_ eq '--test') {
  83.         $nowrite=1;
  84.     } elsif ($_ eq '--keep-old') {
  85.         $keepold=1;
  86.     } elsif ($_ eq '--remove') {
  87.         $remove=1;
  88.     } elsif ($_ eq '--remove-exactly') {
  89.         $remove=1;
  90.         $remove_exactly=1;
  91.     } elsif ($_ eq '--help') {
  92.         &usage(STDOUT); exit 0;
  93.     } elsif ($_ eq '--version') {
  94.         &version; exit 0;
  95.     } elsif ($_ eq '--debug') {
  96.     open(DEBUG,">&STDERR")
  97.         || &quit(sprintf(_g("could not open stderr for output! %s"), $!));
  98.     $debug=1;
  99.     } elsif ($_ eq '--section') {
  100.         if (@ARGV < 2) {
  101.         printf STDERR _g("%s: --section needs two more args")."\n", $name;
  102.             &usage(STDERR); exit 1;
  103.         }
  104.         $sectionre= shift(@ARGV);
  105.         $sectiontitle= shift(@ARGV);
  106.     } elsif (m/^--(c?align|maxwidth)=([0-9]+)$/) {
  107.     warn(sprintf(_g("%s: option --%s is deprecated (ignored)"), $name, $1)."\n");
  108.     } elsif (m/^--info-?dir=/) {
  109.     $dirfile = $' . '/dir';
  110.     } elsif (m/^--info-file=/) {
  111.     $filename = $';
  112.     } elsif (m/^--menuentry=/) {
  113.     $menuentry = $';
  114.     } elsif (m/^--description=/) {
  115.     $description = $';
  116.     } elsif (m/^--dir-file=/) { # for compatibility with GNU install-info
  117.     $dirfile = $';
  118.     } else {
  119.         printf STDERR _g("%s: unknown option \`%s'")."\n", $name, $_;
  120.         &usage(STDERR); exit 1;
  121.     }
  122. }
  123.  
  124. if (!@ARGV) { &usage(STDERR); exit 1; }
  125.  
  126. if ( !$filename ) {
  127.     $filename= shift(@ARGV);
  128.     $name = "$name($filename)";
  129. }
  130. if (@ARGV) { printf STDERR _g("%s: too many arguments")."\n", $name; &usage(STDERR); exit 1; }
  131.  
  132. if ($remove) {
  133.     printf(STDERR _g("%s: --section ignored with --remove")."\n", $name) if length($sectiontitle);
  134.     printf(STDERR _g("%s: --description ignored with --remove")."\n", $name) if length($description);
  135. }
  136.  
  137. printf(STDERR _g("%s: test mode - dir file will not be updated")."\n", $name)
  138.     if $nowrite && !$quiet;
  139.  
  140. umask(umask(0777) & ~0444);
  141.  
  142. if($remove_exactly) {
  143.     $remove_exactly = $filename;
  144. }
  145.  
  146. $filename =~ m|[^/]+$|; $basename= $&; $basename =~ s/(\.info)?(\.gz)?$//;
  147.  
  148. # The location of the info files from the dir entry, i.e. (emacs-20/emacs).
  149. my $fileinentry;
  150.  
  151. &dprint("dirfile='$dirfile' filename='$filename' maxwidth='$maxwidth'");
  152. &dprint("menuentry='$menuentry' basename='$basename'");
  153. &dprint("description='$description' remove=$remove");
  154.  
  155. if (!$remove) {
  156.  
  157.     if (!-f $filename && -f "$filename.gz" || $filename =~ s/\.gz$//) {
  158.         $filename= "gzip -cd <$filename.gz |";  $pipeit= 1;
  159.     } else {
  160.         $filename= "< $filename";
  161.     }
  162.  
  163.     if (!length($description)) {
  164.         
  165.         open(IF,"$filename") || &quit(sprintf(_g("unable to read %s: %s"), $filename, $!));
  166.         $asread='';
  167.         while(<IF>) {
  168.         m/^START-INFO-DIR-ENTRY$/ && last;
  169.         m/^INFO-DIR-SECTION (.+)$/ && do {
  170.         $sectiontitle = $1        unless ($sectiontitle);
  171.         $sectionre = '^'.quotemeta($1)    unless ($sectionre);
  172.         }
  173.     }
  174.         while(<IF>) { last if m/^END-INFO-DIR-ENTRY$/; $asread.= $_; }
  175.     if ($pipeit) {
  176.         while (<IF>) {};
  177.     }
  178.  
  179.         close(IF); &checkpipe;
  180.         if ($asread =~ m/(\*\s*[^:]+:\s*\(([^\)]+)\).*\. *.*\n){2}/) {
  181.             $infoentry= $asread;
  182.             $multiline= 1;
  183.             $fileinentry = $2;
  184.             &dprint("multiline '$asread'");
  185.         } elsif ($asread =~ m/^\*\s*([^:]+):(\s*\(([^\)]+)\)\.|:)\s*/) {
  186.             $menuentry= $1;
  187.             $description = $';
  188.             $fileinentry = $3;
  189.             &dprint("infile menuentry '$menuentry' description '$description'");
  190.         } elsif (length($asread)) {
  191.             printf STDERR _g("%s: warning, ignoring confusing INFO-DIR-ENTRY in file.")."\n", $name;
  192.         }
  193.     }
  194.  
  195.     if (length($infoentry)) {
  196.  
  197.         $infoentry =~ m/\n/;
  198.         print "$`\n" unless $quiet;
  199.         $infoentry =~ m/^\*\s*([^:]+):\s*\(([^\)]+)\)/ || 
  200.             &quit(_g("invalid info entry")); # internal error
  201.         $sortby= $1;
  202.         $fileinentry= $2;
  203.  
  204.     } else {
  205.  
  206.         if (!length($description)) {
  207.             open(IF,"$filename") || &quit(_g("unable to read %s: %s"), $filename, $!);
  208.             $asread='';
  209.             while(<IF>) {
  210.                 if (m/^\s*[Tt]his file documents/) {
  211.                     $asread = $';
  212.                     last;
  213.                 }
  214.             }
  215.             if (length($asread)) {
  216.                 while(<IF>) { last if m/^\s*$/; $asread.= $_; }
  217.                 $description= $asread;
  218.             }
  219.         if ($pipeit) {
  220.         while (<IF>) {};
  221.         }
  222.             close(IF); &checkpipe;
  223.         }
  224.  
  225.         if (!length($description)) {
  226.             printf STDERR _g("
  227. No \`START-INFO-DIR-ENTRY' and no \`This file documents'.
  228. %s: unable to determine description for \`dir' entry - giving up
  229. "), $name;
  230.             exit 1;
  231.         }
  232.  
  233.         $description =~ s/^\s*(.)//;  $_=$1;  y/a-z/A-Z/;
  234.         $description= $_ . $description;
  235.  
  236.         if (!length($menuentry)) {
  237.             $menuentry= $basename;  $menuentry =~ s/\Winfo$//;
  238.             $menuentry =~ s/^.//;  $_=$&;  y/a-z/A-Z/;
  239.             $menuentry= $_ . $menuentry;
  240.         }
  241.  
  242.         &dprint("menuentry='$menuentry'  description='$description'");
  243.  
  244.         if($fileinentry) {
  245.             $cprefix= sprintf("* %s: (%s).", $menuentry, $fileinentry);
  246.         } else {
  247.             $cprefix= sprintf("* %s: (%s).", $menuentry, $basename);
  248.         }
  249.  
  250.         $align--; $calign--;
  251.         $lprefix= length($cprefix);
  252.         if ($lprefix < $align) {
  253.             $cprefix .= ' ' x ($align - $lprefix);
  254.             $lprefix= $align;
  255.         }
  256.         $prefix= "\n". (' 'x $calign);
  257.         $cwidth= $maxwidth+1;
  258.  
  259.         for $_ (split(/\s+/,$description)) {
  260.             $l= length($_);
  261.             $cwidth++; $cwidth += $l;
  262.             if ($cwidth > $maxwidth) {
  263.                 $infoentry .= $cprefix;
  264.                 $cwidth= $lprefix+1+$l;
  265.                 $cprefix= $prefix; $lprefix= $calign;
  266.             }
  267.             $infoentry.= ' '; $infoentry .= $_;
  268.         }
  269.  
  270.         $infoentry.= "\n";
  271.         print $infoentry unless $quiet;
  272.         $sortby= $menuentry;  $sortby =~ y/A-Z/a-z/;
  273.  
  274.     }
  275. }
  276.  
  277. if (!$nowrite && ( ! -e $dirfile || ! -s _ )) {
  278.     if (-r $backup) {
  279.     printf( STDERR _g("%s: no file %s, retrieving backup file %s.")."\n",
  280.         $name, $dirfile, "$backup" );
  281.     if (system ('cp', $backup, $dirfile)) {
  282.         printf( STDERR _g("%s: copying %s to %s failed, giving up: %s")."\n",
  283.             $name, $backup, $dirfile, $! );
  284.         exit 1;
  285.     }
  286.     } else {
  287.         if (-r $default) {
  288.         printf( STDERR _g("%s: no backup file %s available, retrieving default file.")."\n",
  289.             $name, $backup );
  290.  
  291.         if (system('cp', $default, $dirfile)) {
  292.         printf( STDERR _g("%s: copying %s to %s failed, giving up: %s")."\n",
  293.             $name, $default, $dirfile, $! );
  294.         exit 1;
  295.         }
  296.     } else {
  297.         printf STDERR _g("%s: no backup file %s available.")."\n", $name, $backup;
  298.         printf STDERR _g("%s: no default file %s available, giving up.")."\n", $name, $default;
  299.         exit 1;
  300.     }
  301.     }
  302. }
  303.  
  304. if (!$nowrite && !link($dirfile, "$dirfile.lock")) {
  305.     printf( STDERR _g("%s: failed to lock dir for editing! %s")."\n",
  306.         $name, $! );
  307.     printf( STDERR _g("try deleting %s?")."\n", "$dirfile.lock")
  308.     if $!{EEXIST};
  309.     exit 1;
  310. }
  311.  
  312. open(OLD, $dirfile) || &ulquit(sprintf(_g("unable to open %s: %s"), $dirfile, $!));
  313. @work= <OLD>;
  314. eof(OLD) || &ulquit(sprintf(_g("unable to read %s: %s"), $dirfile, $!));
  315. close(OLD) || &ulquit(sprintf(_g("unable to close %s after read: %s"),
  316.                  $dirfile, $!));
  317.  
  318. while (($#work >= 0) && ($work[$#work] !~ m/\S/)) { $#work--; }
  319.  
  320. while (@work) {
  321.     $_= shift(@work);
  322.     push(@head,$_);
  323.     last if (m/^\*\s*Menu:/i);
  324. }
  325.  
  326. if (!$remove) {
  327.  
  328.     my $target_entry;
  329.  
  330.     if($fileinentry) {
  331.         $target_entry = $fileinentry;
  332.     } else {
  333.         $target_entry = $basename;
  334.     }
  335.  
  336.     for ($i=0; $i<=$#work; $i++) {
  337.         next unless $work[$i] =~ m/^\*\s*[^:]+:\s*\(([^\)]+)\).*\.\s/;
  338.         last if $1 eq $target_entry || $1 eq "$target_entry.info";
  339.     }
  340.     for ($j=$i; $j<=$#work+1; $j++) {
  341.         next if $work[$j] =~ m/^\s+\S/;
  342.         last unless $work[$j] =~ m/^\* *[^:]+: *\(([^\)]+)\).*\.\s/;
  343.         last unless $1 eq $target_entry || $1 eq "$target_entry.info";
  344.     }
  345.  
  346.     if ($i < $j) {
  347.         if ($keepold) {
  348.             printf(_g("%s: existing entry for \`%s' not replaced")."\n", $name, $target_entry) unless $quiet;
  349.             $nowrite=1;
  350.         } else {
  351.             printf(_g("%s: replacing existing dir entry for \`%s'")."\n", $name, $target_entry) unless $quiet;
  352.         }
  353.         $mss= $i;
  354.         @work= (@work[0..$i-1], @work[$j..$#work]);
  355.     } elsif (length($sectionre)) {
  356.         $mss= -1;
  357.         for ($i=0; $i<=$#work; $i++) {
  358.             $_= $work[$i];
  359.             next if m/^(\*|\s)/;
  360.             next unless m/$sectionre/io;
  361.             $mss= $i+1; last;
  362.         }
  363.         if ($mss < 0) {
  364.             printf(_g("%s: creating new section \`%s'")."\n", $name, $sectiontitle) unless $quiet;
  365.             for ($i= $#work; $i>=0 && $work[$i] =~ m/\S/; $i--) { }
  366.             if ($i <= 0) { # We ran off the top, make this section and Misc.
  367.                 printf(_g("%s: no sections yet, creating Miscellaneous section too.")."\n", $name)
  368.                     unless $quiet;
  369.                 @work= ("\n", "$sectiontitle\n", "\n", "Miscellaneous:\n", @work);
  370.                 $mss= 1;
  371.             } else {
  372.                 @work= (@work[0..$i], "$sectiontitle\n", "\n", @work[$i+1..$#work]);
  373.                 $mss= $i+1;
  374.             }
  375.         }
  376.         while ($mss <= $#work) {
  377.             $work[$mss] =~ m/\S/ || last;
  378.             $work[$mss] =~ m/^\* *([^:]+):/ || ($mss++, next);
  379.             last if $multiline;
  380.             $_=$1;  y/A-Z/a-z/;
  381.             last if $_ gt $sortby;
  382.             $mss++;
  383.         }
  384.     } else {
  385.         printf(_g("%s: no section specified for new entry, placing at end")."\n", $name)
  386.             unless $quiet;
  387.         $mss= $#work+1;
  388.     }
  389.  
  390.     @work= (@work[0..$mss-1], map("$_\n",split(/\n/,$infoentry)), @work[$mss..$#work]);
  391.     
  392. } else {
  393.  
  394.     my $target_entry;
  395.  
  396.     if($remove_exactly) {
  397.         $target_entry = $remove_exactly;
  398.     } else {
  399.         $target_entry = $basename;
  400.     }
  401.  
  402.     for ($i=0; $i<=$#work; $i++) {
  403.         next unless $work[$i] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/;
  404.         $tme= $1; $tfile= $2; $match= $&;
  405.         next unless $tfile eq $target_entry;
  406.         last if !length($menuentry);
  407.         $tme =~ y/A-Z/a-z/;
  408.         last if $tme eq $menuentry;
  409.     }
  410.     for ($j=$i; $j<=$#work+1; $j++) {
  411.         next if $work[$j] =~ m/^\s+\S/;
  412.         last unless $work[$j] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/;
  413.         $tme= $1; $tfile= $2;
  414.         last unless $tfile eq $target_entry;
  415.         next if !length($menuentry);
  416.         $tme =~ y/A-Z/a-z/;
  417.         last unless $tme eq $menuentry;
  418.     }
  419.  
  420.     if ($i < $j) {
  421.         &dprint("i=$i \$work[\$i]='$work[$i]' j=$j \$work[\$j]='$work[$j]'");
  422.         printf(_g("%s: deleting entry \`%s ...'")."\n", $name, $match) unless $quiet;
  423.         $_= $work[$i-1];
  424.         unless (m/^\s/ || m/^\*/ || m/^$/ ||
  425.                 $j > $#work || $work[$j] !~ m/^\s*$/) {
  426.             s/:?\s+$//;
  427.             if ($keepold) {
  428.                 printf(_g("%s: empty section \`%s' not removed")."\n", $name, $_) unless $quiet;
  429.             } else {
  430.                 $i--; $j++;
  431.                 printf(_g("%s: deleting empty section \`%s'")."\n", $name, $_) unless $quiet;
  432.             }
  433.         }
  434.         @work= (@work[0..$i-1], @work[$j..$#work]);
  435.     } else {
  436.         unless ($quiet) {
  437.             if (length($menuentry)) {
  438.                 printf _g("%s: no entry for file \`%s' and menu entry \`%s'")."\n", $name, $target_entry, $menuentry;
  439.             } else {
  440.                 printf _g("%s: no entry for file \`%s'")."\n", $name, $target_entry;
  441.             }
  442.         }
  443.     }
  444. }
  445. $length = 0;
  446.  
  447. $j = -1;
  448. for ($i=0; $i<=$#work; $i++) {
  449.     $_ = $work[$i];
  450.     chomp;
  451.     if ( m/^(\* *[^:]+: *\(\w[^\)]*\)[^.]*\.)[ \t]*(.*)/ ) {
  452.         $length = length($1) if ( length($1) > $length );
  453.         $work[++$j] = $_;
  454.     } elsif ( m/^[ \t]+(.*)/ ) {
  455.         $work[$j] = "$work[$j] $1";
  456.     } else {
  457.         $work[++$j] = $_;
  458.     }
  459. }
  460. @work = @work[0..$j];
  461.  
  462. my $descalign=40;
  463.  
  464. @newwork = ();
  465. foreach ( @work ) {
  466.     if ( m/^(\* *[^:]+: *\(\w[^\)]*\)[^.]*\.)[ \t]*(.*)/ ||
  467.         m/^([ \t]+)(.*)/ ) {
  468.         if (length $1 >= $descalign) {
  469.             push @newwork, $1;
  470.             $_=(" " x $descalign) . $2;
  471.         }
  472.         else {
  473.             $_ = $1 . (" " x ($descalign - length $1)) . $2;
  474.         }
  475.         push @newwork, split( "\n", wrap('', " " x $descalign, $_ ) );
  476.     } else {
  477.         push @newwork, $_;
  478.     }
  479. }
  480.  
  481. if (!$nowrite) {
  482.     open(NEW,"> $dirfile.new") || &ulquit(sprintf(_g("unable to create %s: %s"),
  483.                              "$dirfile.new", $!));
  484.     print(NEW @head,join("\n",@newwork)) ||
  485.     &ulquit(sprintf(_g("unable to write %s: %s"), "$dirfile.new", $!));
  486.     close(NEW) || &ulquit(sprintf(_g("unable to close %s: %s"), "$dirfile.new", $!));
  487.  
  488.     unlink("$dirfile.old");
  489.     link($dirfile, "$dirfile.old") ||
  490.     &ulquit(sprintf(_g("unable to backup old %s, giving up: %s"),
  491.                $dirfile, $!));
  492.     rename("$dirfile.new", $dirfile) ||
  493.     &ulquit(sprintf(_g("unable to install new %s: %s"), $dirfile, $!));
  494.  
  495.     unlink("$dirfile.lock") ||
  496.     &quit(sprintf(_g("unable to unlock %s: %s"), $dirfile, $!));
  497.     system ('cp', $dirfile, $backup) &&
  498.     warn sprintf(_g("%s: could not backup %s in %s: %s"), $name, $dirfile, $backup, $!)."\n";
  499. }
  500.  
  501. sub quit
  502. {
  503.     die "$name: $@\n";
  504. }
  505.  
  506. sub ulquit {
  507.     unlink("$dirfile.lock") ||
  508.     warn sprintf(_g("%s: warning - unable to unlock %s: %s"),
  509.              $name, $dirfile, $!)."\n";
  510.     &quit($_[0]);
  511. }
  512.  
  513. sub checkpipe {
  514.     return if !$pipeit || !$? || $?==0x8D00 || $?==0x0D;
  515.     &quit(sprintf(_g("unable to read %s: %d"), $filename, $?));
  516. }
  517.  
  518. sub dprint {
  519.     printf(DEBUG _g("dbg: %s")."\n", $_[0]) if ($debug);
  520. }
  521.  
  522. exit 0;
  523.